## Created by EmpowerStats @ Fri, 15 Nov 24 17:18:06 +0800## 
#******************** Regarding ALL Following R Code   ******************** 
#*** COPYRIGHT (c) 2010, 2021 X&Y Solutions, ALL RIGHT RESERVED *********** 
#******************* www.EmpowerStats.com ********************************* 
#************************************************************************** 
Sys.setlocale(category = 'LC_ALL', locale = 'English_United States.1252'); 
.libPaths(file.path(R.home(),'library')); 
library(doBy); 
options(timeout=600); 
library(R.oo); 
library(foreign); 
library(Hmisc); 
library(stringi); 
library(stringr); 
setwd('/Users/liukangning/Desktop/EmpowerROS/Analysis/cognitivedepression/Demographics '); 
readEPD<-function(inFile, fmt, skips=0, nrows=-1, setCols=NA) {
  tmp <- unlist(strsplit(fmt," "))
  if (length(tmp)==1) tmp <- unlist(strsplit(fmt,"\\."))
  fmt <- tmp[1]
  if (length(tmp)>1) skips = tmp[2]
  if (fmt=="CSV") {
    d<-read.table(inFile, header=TRUE, quote="\"'", as.is=TRUE, na.string=c("NA",".",""," "), comment.char="",
    sep=",", nrows=nrows, skip=skips, blank.lines.skip=TRUE, fill=TRUE, colClasses=setCols)
  }
  if (fmt=="CSV2") {
    d<-read.table(inFile, header=TRUE, quote="\"'", as.is=TRUE, na.string=c("NA",".",""," "), comment.char="",
    sep=";", nrows=nrows, skip=skips, blank.lines.skip=TRUE, fill=TRUE, colClasses=setCols)
  }  
  if (fmt=="TXT") {
    d<-read.table(inFile, header=TRUE, quote="\"'", as.is=TRUE, na.string=c("NA",".",""," "), comment.char="",
    sep="", nrows=nrows, skip=skips, blank.lines.skip=TRUE, fill=TRUE, colClasses=setCols)
  }
  if (fmt=="TAB") {
    d<-read.table(inFile, header=TRUE, quote="\"'", as.is=TRUE, na.string=c("NA",".",""," "), comment.char="",
    sep="\t", nrows=nrows, skip=skips, blank.lines.skip=TRUE, fill=TRUE, colClasses=setCols)
  }
  if (fmt=="RDATA") {load(inFile); d<-get(ls());}
  if (fmt=="SAS7BDAT") {
     source("http://www.empowerstats.com/empowerStats/R.functions/_read.sas7bdat.R")
     d<-read.sas7bdat(inFile)
  }
  if (fmt=="XPT") {d<-sasxport.get(inFile);}
  if (fmt=="SAV") {
     d<-read.spss(inFile,to.data.frame = TRUE,use.value.labels = FALSE)
  }
  if (fmt=="DTA") {
     if (!("haven" %in% rownames(installed.packages()))) install.packages("haven",repos='https://cloud.r-project.org'); 
     library(haven)
     d<-as.data.frame(read_dta(inFile))
  }
  if (file.info(inFile)$size < 300*1024*1024) {  
    d<-d[(apply(is.na(d),1,sum)<ncol(d)),]
    d<-d[,(apply(is.na(d),2,sum)<nrow(d))]
  }
  cname<-gsub("\\.+","\\.",colnames(d))
  cx <- endsWith(cname,".")
  if (sum(cx)>0) cname[cx] <- substr(cname[cx],1,nchar(cname[cx])-1)
  cname <- toupper(cname)  
  cnamef <- table(cname); rep <- names(cnamef[cnamef > 1]); 
  if (length(rep)>0) {
    for (i in 1:length(rep)) cname[which(cname==rep[i])]<-paste(rep[i], 1:cnamef[rep[i]], sep=".")
  }
  rm(cnamef, rep); gc();
  colnames(d)<-cname  
  return(d)
}
readCsvRows<-function(inFile, fmt, start=1, ends=-1, setCols=NA) { 
  if (fmt == "") {
    dtab<-read.table(inFile, header=TRUE, quote="\"'", as.is=TRUE, na.string=c("NA",".",""," "), sep="\t", nrows=3, skip=0)
    dcsv<-read.table(inFile, header=TRUE, quote="\"'", as.is=TRUE, na.string=c("NA",".",""," "), sep=",", nrows=3, skip=0)
    n3<-c(ncol(dtab), ncol(dcsv))
    fmt<- c("TAB","CSV")[which(n3==max(n3))]
    rm(dtab, dcsv); gc()  
  }   
  sep<- ifelse(fmt=="CSV", ",", ifelse(fmt=="TAB", "\t", " "))
  skips<-start;  if (skips<1) skips<-1;
  if (ends>start) {nrows<-1+ends-start;} else {nrows=-1;}
  r0<-read.table(inFile, header=TRUE, sep=sep, nrows=1, skip=0, colClasses=setCols)
  d<-read.table(inFile, header=FALSE, as.is=TRUE, na.string=c("NA",".",""," "), comment.char="", 
    sep=sep, nrows=nrows, skip=skips, blank.lines.skip=TRUE, fill=TRUE, colClasses=setCols)
  cname<-gsub("\\.+","\\.",colnames(r0))
  cx <- endsWith(cname,".")
  if (sum(cx)>0) cname[cx] <- substr(cname[cx],1,nchar(cname[cx])-1)
  cname <- toupper(cname)  
  cnamef <- table(cname); rep <- names(cnamef[cnamef > 1]); 
  if (length(rep)>0) {
    for (i in 1:length(rep)) cname[which(cname==rep[i])]<-paste(rep[i], 1:cnamef[rep[i]], sep=".")
  }
  rm(cnamef, rep); gc();
  colnames(d)<-cname   
  return(d)
}
 
inFile <- 'DEMOG.XPT'; 
setCols<-NA; 
EmpowerStatsR<-readEPD(inFile,'XPT',setCols=setCols); 
save(EmpowerStatsR, file='DEMOG.Rdata'); 
chr_matrix2nchar<-function(mx,l, append) {
 ch="                                                                                                       "
 mx[is.na(mx)]<-"NA"
 g0=stri_length(as.character(mx)) 
 if (l>max(g0,na.rm=TRUE)) {
   g1=stri_sub(rep(ch,length(g0)),1,l-g0)
   if (append==T) {oo<-paste(mx,g1,sep="")} else {oo<-paste(g1,mx,sep="")}
   } else {oo<-stri_sub(mx,1,l)}
 return(oo)
}
lstvar <- function(mx) {
  ss<-stri_sub(mx, from = 1L, length=40)
  nmiss <- sum(is.na(mx))
  ntotal<- length(mx)
  ss<-unique(ss)
  ss1<-ss[order(ss)]
  nunique<-length(ss1)
  oo<-rbind(ss1[1],ss1[2],ss1[3],"......",ss1[round(nunique/2,0)],"......",ss1[nunique-2],ss1[nunique-1],ss1[nunique],"------")
  oo<-rbind(oo,paste("Total:",ntotal, "  unique:", nunique, "  Missing:", nmiss))
  oo<-matrix(paste("       ",oo),ncol=1)
  return(oo)
}
frqvar<-function(mx) {
 mxwidth<-max(stri_length(mx),na.rm=TRUE)
 if (mxwidth<=12 | is.numeric(mx)) {
   oo1 <- "         value        count -------- percent -------------------------"
   ss<-as.matrix(table(mx,useNA="ifany"))
   s1<-substr(as.character(rownames(ss)),0,9)
   s2<-as.character(ss)
   p<-round(ss/sum(ss,na.rm=TRUE)*100,2)
   nstr<-round(p/3,0)
   star<-rep("****************************************************",times=nrow(nstr))
   s3<-stri_sub(star,1,nstr)
   oo2<-paste("         ",chr_matrix2nchar(s1,12,append=T),chr_matrix2nchar(s2,6,append=F),"|",s3,p,"%",sep="")
   oo3<-paste("             Total   ",chr_matrix2nchar(sum(ss,na.rm=TRUE),6,append=F),sep="")
   oo=rbind(oo1,as.matrix(oo2,ncol=1),oo3)
 } else {
   if (mxwidth>65) {mxwidth<-65};
   tt="                                                                 "
   oo1 <- paste("    value",stri_sub(tt,1,mxwidth),"   count",sep="")
   ss<-as.matrix(table(mx,useNA="ifany"))
   s1<-stri_sub(as.character(rownames(ss)),1,mxwidth)
   s1<-ifelse(stri_length(s1)>=65,paste(s1,"...",sep=""),s1)
   s2<-as.character(ss)
   p<-round(ss/sum(ss,na.rm=TRUE)*100,2)
   oo2<-paste("    ",chr_matrix2nchar(s1,mxwidth+5,append=T),chr_matrix2nchar(s2,8,append=F),"|",p,"%",sep="")
   oo3<-paste("    Total",chr_matrix2nchar(sum(ss,na.rm=TRUE),mxwidth+8,append=F),sep="")
   oo=rbind(oo1,as.matrix(oo2,ncol=1),oo3)
 } 
 return(oo)
} 
univar<-function(mx) {
 n<-sum(!is.na(mx))
 xx0<-c(' min','  5%',' 10%',' 25%',' 50%',' 75%',' 90%',' 95%',' max','mean',' std','   n');
 xx1<-quantile(mx, probs=c(0,0.05,0.10,0.25,0.50,0.75,0.90,0.95,1), na.rm=TRUE)
 xx1<-append(xx1,mean(mx,na.rm=TRUE),after=length(xx1))
 xx1<-append(xx1,sd(mx,na.rm=TRUE),after=length(xx1))
 xx1<-round(xx1,3)
 xx1<-append(xx1,n,after=length(xx1))
 xx1<-chr_matrix2nchar(as.matrix(xx1),15,append=F)
 d<-(max(mx[mx!=Inf],na.rm=TRUE)-min(mx[mx!=-Inf],na.rm=TRUE))/10
 xx2<-seq(min(mx[mx!=-Inf],na.rm=TRUE),max(mx[mx!=Inf],na.rm=TRUE),d)
 dtn<-rep(0,10)
 for (i in (1:10)) dtn[i]<-sum(mx>xx2[i],na.rm=TRUE)
 dtn<-dtn-append(dtn[-1],0)
 dtn<-append(1,dtn,after=1)
 dtn<-append(dtn,1,after=length(dtn))
 xx2<-append(min(mx[mx!=-Inf],na.rm=TRUE),xx2[-1]-d/2,after=1)
 xx2<-append(xx2,max(mx[mx!=Inf],na.rm=TRUE),after=length(xx2))
 xx2<-round(xx2,3)
 xx2<-chr_matrix2nchar(as.matrix(xx2),15,append=F)
 dtn=round(dtn*40/n,0)
 star<-"*******************************************************"
 xx3<-stri_sub(rep(star,length(dtn)),1,dtn)
 oo<-"   percentile                         |--------distribution--------------"
 oo<-rbind(oo,as.matrix(paste("   ",xx0,xx1,xx2," |",xx3,sep=""),ncol=1))
 o1<-paste("      .",chr_matrix2nchar(sum(is.na(mx)),15,append=F),"                |--------distribution--------------",sep="")
 oo<-rbind(oo,o1)
 return(oo)
}
DATADST <- function(EmpowerStatsR, outfile, datatxt, pathtxt, vlabel) {
 nvar<-ncol(EmpowerStatsR)
 nobs<-nrow(EmpowerStatsR)
 vname<-names(EmpowerStatsR)
 vtype<-rep("n",nvar)
 vlength<-rep(1,nvar)
 if (length(vlabel)!=nvar) vlabel=rep(" ",nvar)
 xx="OUTPUT of datadst() Programed by EmpowerStats (www.empowerstats.com)"
 xx=rbind(xx, paste("Data file name        :", datatxt))
 xx=rbind(xx, paste("Data location         :", pathtxt))
 xx=rbind(xx, paste("Number of observations:", nobs))
 xx=rbind(xx, paste("Number of variables   :", nvar)) 
 xx=rbind(xx, "Variables List:")
 for (i in (1:nvar)) {
  if (!is.numeric(EmpowerStatsR[,i])) vtype[i]="$"
  vlength[i]=max(stri_length(as.character(EmpowerStatsR[,i])),na.rm=TRUE)
 }
 varnchar<-max(max(stri_length(vname),na.rm=TRUE)+2, 15)
 vtypelg<-paste(vtype,vlength,sep="")
 vtlnchr<-max(max(stri_length(vtypelg),na.rm=TRUE)+2,5)
 vartxt<-paste(" ",chr_matrix2nchar(vname,varnchar,append=T),chr_matrix2nchar(vtypelg,vtlnchr,append=T),vlabel, sep="")
 xx=rbind(xx,as.matrix(vartxt))
 xx=rbind(xx,"Variables Distribution:")
 for (i in (1:nvar)) {
  mx<-as.matrix(EmpowerStatsR[,i],ncol=1)
  viuni <- length(unique(EmpowerStatsR[,i]))
  vitype<- is.numeric(EmpowerStatsR[,i])
  xx=rbind(xx,"    ",vname[i])
  if (vitype) {
   if (viuni>20) xx=rbind(xx, univar(mx))
   else xx=rbind(xx,frqvar(mx)) 
  } else {
   if (viuni>100) xx=rbind(xx, lstvar(mx))
   else xx=rbind(xx,frqvar(mx)) 
  }
 }
 xx=rbind(xx, "    ")
 xx=rbind(xx, "******************** THE END ************************")
 write.table(xx,file=outfile,quote=FALSE,col.names=FALSE,row.names=FALSE)
}
DFMDST <- function(DFM, ofile, vtype=c()) {
  nvar<-ncol(DFM); vname<-names(DFM); 
  if (length(vtype)==0) vtype=rep(NA,nvar)
  for (i in (1:nvar)) {
    mx<-as.matrix(DFM[,i],ncol=1)
    viuni <- length(unique(DFM[,i]))
    vitype<- is.numeric(DFM[,i])
    xx=rbind("    ",vname[i])
    if (vitype) {
      if (is.na(vtype[i])) {
        if (viuni>20) {xx=rbind(xx, univar(mx));} else {xx=rbind(xx,frqvar(mx));}
      } else {
        if (vtype[i]==0) {xx=rbind(xx, univar(mx));} else {xx=rbind(xx,frqvar(mx));}
      }  
    } else {
      if (viuni>100) {xx=rbind(xx, lstvar(mx));} else {xx=rbind(xx,frqvar(mx));}
    }
    write.table(xx,file=ofile,quote=FALSE,col.names=FALSE,row.names=FALSE,append=TRUE)
  }
} 
outfile<-'DEMOG.dst'; 
datatxt<-'DEMOG.XPT'; 
pathtxt<-'/Users/liukangning/Desktop/EmpowerROS/Analysis/cognitivedepression/Demographics '; 
DATADST(EmpowerStatsR, outfile,datatxt,pathtxt,names(EmpowerStatsR));